home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2007 September / PCWSEP07.iso / Software / Linux / Linux Mint 3.0 Light / LinuxMint-3.0-Light.iso / casper / filesystem.squashfs / usr / share / festival / clunits.scm < prev    next >
Encoding:
Text File  |  2006-12-20  |  9.1 KB  |  247 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;;                                                                       ;;
  3. ;;;                   Carnegie Mellon University and                      ;;
  4. ;;;                Centre for Speech Technology Research                  ;;
  5. ;;;                     University of Edinburgh, UK                       ;;
  6. ;;;                       Copyright (c) 1998-2001                         ;;
  7. ;;;                        All Rights Reserved.                           ;;
  8. ;;;                                                                       ;;
  9. ;;;  Permission is hereby granted, free of charge, to use and distribute  ;;
  10. ;;;  this software and its documentation without restriction, including   ;;
  11. ;;;  without limitation the rights to use, copy, modify, merge, publish,  ;;
  12. ;;;  distribute, sublicense, and/or sell copies of this work, and to      ;;
  13. ;;;  permit persons to whom this work is furnished to do so, subject to   ;;
  14. ;;;  the following conditions:                                            ;;
  15. ;;;   1. The code must retain the above copyright notice, this list of    ;;
  16. ;;;      conditions and the following disclaimer.                         ;;
  17. ;;;   2. Any modifications must be clearly marked as such.                ;;
  18. ;;;   3. Original authors' names are not deleted.                         ;;
  19. ;;;   4. The authors' names are not used to endorse or promote products   ;;
  20. ;;;      derived from this software without specific prior written        ;;
  21. ;;;      permission.                                                      ;;
  22. ;;;                                                                       ;;
  23. ;;;  THE UNIVERSITY OF EDINBURGH, CARNEGIE MELLON UNIVERSITY AND THE      ;;
  24. ;;;  CONTRIBUTORS TO THIS WORK DISCLAIM ALL WARRANTIES WITH REGARD TO     ;;
  25. ;;;  THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY   ;;
  26. ;;;  AND FITNESS, IN NO EVENT SHALL THE UNIVERSITY OF EDINBURGH, CARNEGIE ;;
  27. ;;;  MELLON UNIVERSITY NOR THE CONTRIBUTORS BE LIABLE FOR ANY SPECIAL,    ;;
  28. ;;;  INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER          ;;
  29. ;;;  RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN  AN ACTION   ;;
  30. ;;;  OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF     ;;
  31. ;;;  OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.       ;;
  32. ;;;                                                                       ;;
  33. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  34. ;;;
  35. ;;;  Cluster Unit selection support (Black and Taylor Eurospeech '97)
  36. ;;;
  37. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  38. ;;;
  39. ;;;  Run-time support, selection and synthesis and some debugging functions
  40. ;;;
  41. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  42.  
  43. (require_module 'clunits)
  44.  
  45. (defvar cluster_synth_pre_hooks nil)
  46. (defvar cluster_synth_post_hooks nil)
  47.  
  48. (defvar clunits_time time)  ;; some old voices might use this
  49.  
  50. (defSynthType Cluster
  51.     (apply_hooks cluster_synth_pre_hooks utt)
  52.     (Clunits_Select utt)
  53.     (Clunits_Get_Units utt)
  54.     (Clunits_Join_Units utt)
  55.     (apply_hooks cluster_synth_post_hooks utt)
  56.     utt
  57. )
  58.  
  59. (define (Clunits_Join_Units utt)
  60.   "(Clunits_Join_Units utt)
  61. Join the preselected and gotten units into a waveform."
  62.   (let ((join_method (get_param 'join_method clunits_params 'simple)))
  63.     ;; Choice of function to put them together
  64.     (cond
  65.      ((string-equal join_method 'windowed)
  66.       (Clunits_Windowed_Wave utt)
  67.       (clunits::fix_segs_durs utt))
  68.      ((string-equal join_method 'smoothedjoin)
  69.       (Clunits_SmoothedJoin_Wave utt)
  70.       (clunits::fix_segs_durs utt))
  71.      ((string-equal join_method 'none)
  72.       t)
  73.      ((string-equal join_method 'modified_lpc)
  74.       (defvar UniSyn_module_hooks nil)
  75.       (Param.def "unisyn.window_name" "hanning")
  76.       (Param.def "unisyn.window_factor" 1.0)
  77.       (Parameter.def 'us_sigpr 'lpc)
  78.       (mapcar 
  79.        (lambda (u s)
  80.      (item.set_feat s "source_end" (item.feat u "end")))
  81.        (utt.relation.items utt 'Unit)
  82.        (utt.relation.items utt 'Segment))
  83.       (us_unit_concat utt)
  84.       (if (boundp 'awb_hack1)
  85.       (awb_hack1 utt))
  86.       (if (not (member 'f0 (utt.relationnames utt)))
  87.       (targets_to_f0 utt))
  88.       (if (utt.relation.last utt 'Segment)
  89.       (set! pm_end (+ (item.feat (utt.relation.last utt 'Segment) "end")
  90.               0.02))
  91.       (set! pm_end 0.02))
  92.       (us_f0_to_pitchmarks  utt 'f0 'TargetCoef pm_end)
  93.       (us_mapping utt 'segment_single)
  94.       (us_generate_wave utt (Parameter.get 'us_sigpr)
  95.             'analysis_period))
  96.      ((string-equal join_method 'smoothed_lpc)
  97.       (format t "smoothed_lpc\n")
  98.       (defvar UniSyn_module_hooks nil)
  99.       (Param.def "unisyn.window_name" "hanning")
  100.       (Param.def "unisyn.window_factor" 1.0)
  101.       (Parameter.def 'us_sigpr 'lpc)
  102.       (mapcar 
  103.        (lambda (u s)
  104.      (item.set_feat s "source_end" (item.feat u "end"))
  105.      (item.set_feat s "unit_duration" 
  106.             (- (item.feat u "seg_end") (item.feat u "seg_start")))
  107.      )
  108.        (utt.relation.items utt 'Unit)
  109.        (utt.relation.items utt 'Segment))
  110.       (us_unit_concat utt)
  111.       (mapcar 
  112.        (lambda (u s)
  113.      (item.set_feat s "num_frames" (item.feat u "num_frames")))
  114.        (utt.relation.items utt 'Unit)
  115.        (utt.relation.items utt 'Segment))
  116.       (if (not (member 'f0 (utt.relationnames utt)))
  117.       (targets_to_f0 utt))
  118.       (if (utt.relation.last utt 'Segment)
  119.       (set! pm_end (+ (item.feat (utt.relation.last utt 'Segment) "end")
  120.               0.02))
  121.       (set! pm_end 0.02))
  122.       (us_f0_to_pitchmarks  utt 'f0 'TargetCoef pm_end)
  123.       (cl_mapping utt clunits_params)
  124.       (us_generate_wave utt (Parameter.get 'us_sigpr)
  125.             'analysis_period))
  126.      (t
  127.       (Clunits_Simple_Wave utt)))
  128.     utt
  129.   )
  130. )
  131.  
  132. (define (clunits::units_selected utt filename)
  133.   "(clunits::units_selected utt filename)
  134. Output selected unitsfile indexes for each unit in the given utterance.
  135. Results saved in given file name, or stdout if filename is \"-\"."
  136.   (let ((fd (if (string-equal filename "-")
  137.         t
  138.         (fopen filename "w")))
  139.     (end 0)
  140.     (sample_rate
  141.      (cadr (assoc 'sample_rate (wave.info (utt.wave utt))))))
  142.     (format fd "#\n")
  143.     (mapcar
  144.      (lambda (s)
  145.        (let ((dur (/ (- (item.feat s "samp_end")
  146.               (item.feat s "samp_start"))
  147.            sample_rate))
  148.          (start (/ (item.feat s "samp_start") sample_rate)))
  149.      (set! end (+ end dur))
  150.      (format fd "%f 125 %s ; %s %10s %f %f %f\n"
  151.          end
  152.          (string-before (item.name s) "_")
  153.          (item.name s)
  154.          (item.feat s "fileid")
  155.          (item.feat s "unit_start")
  156.          (item.feat s "unit_middle")
  157.          (item.feat s "unit_end"))
  158.      ))
  159.      (utt.relation.items utt 'Unit))
  160.     (if (not (string-equal filename "-"))
  161.     (fclose fd))
  162.     t))
  163.  
  164. (define (clunits::units_segs utt filename)
  165.   "(clunits::units_segs utt filename)
  166. Svaes the unit selections (alone) for display."
  167.   (let ((fd (if (string-equal filename "-")
  168.         t
  169.         (fopen filename "w")))
  170.     (end 0)
  171.     (sample_rate
  172.      (cadr (assoc 'sample_rate (wave.info (utt.wave utt))))))
  173.     (format fd "#\n")
  174.     (mapcar
  175.      (lambda (s)
  176.        (let ((dur (/ (- (item.feat s "samp_end")
  177.               (item.feat s "samp_start"))
  178.            sample_rate))
  179.          (start (/ (item.feat s "samp_start") sample_rate)))
  180.      (set! end (+ end dur))
  181.      (format fd "%f 125 %s \n"
  182.          end
  183.          (string-before (item.name s) "_")
  184. ;         (item.name s)
  185.          )
  186.      ))
  187.      (utt.relation.items utt 'Unit))
  188.     (if (not (string-equal filename "-"))
  189.     (fclose fd))
  190.     t))
  191.  
  192. (define (clunits::fix_segs_durs utt)
  193.   "(clunits::fix_segs_durs utt)
  194. Takes the actual unit times and places then back on the segs."
  195.   (let ((end 0)
  196.     (sample_rate
  197.      (cadr (assoc 'sample_rate (wave.info (utt.wave utt))))))
  198.     (mapcar
  199.      (lambda (u s)
  200.        (let ((dur (/ (- (item.feat u "samp_end")
  201.               (item.feat u "samp_start"))
  202.            sample_rate))
  203.          (seg_start (/ (- (item.feat u "samp_seg_start")
  204.                 (item.feat u "samp_start"))
  205.              sample_rate)))
  206.      (if (item.prev s)
  207.          (item.set_feat (item.prev s) "end" 
  208.                 (+ (item.feat s "p.end") seg_start)))
  209.      (set! end (+ end dur))
  210.      (item.set_feat s "end" end)))
  211.      (utt.relation.items utt 'Unit)
  212.      (utt.relation.items utt 'Segment)
  213.      )
  214.     utt))
  215.  
  216. (define (clunits::display utt)
  217.   "(clunits::display utt)
  218. Display utterance with emulabel.  Note this saves files in
  219. scratch/wav/ and scratch/lab/."
  220.   (let ((id "cl01"))
  221.     (utt.save.wave utt (format nil "scratch/wav/%s.wav" id))
  222.     (utt.save.segs utt (format nil "scratch/lab/%s.lab" id))
  223.     (system "cd scratch; emulabel ../etc/emu_lab cl01 &")
  224.     t))
  225.  
  226. ; (define (clunits::debug_resynth_units utt)
  227. ;   "(clunits::debug_resynth_units utt)
  228. ; Check each of the units in utt against the related label
  229. ; files and re-synth with any given new boundaries.  Note this is 
  230. ; will only work if the segment still overlaps with its original and
  231. ; also note that with a rebuild of the clunits db a complete different
  232. ; set of units may be selected for this utterance."
  233. ;   (let ()
  234. ;     (mapcar 
  235. ;      (lambda (unit)
  236. ;        (clunits::check_unit_boundaries unit))
  237. ;      (utt.relation.items utt 'Unit))
  238. ;     ;; This can't be done like this ... 
  239. ;     (Clunits_Get_Units utt)  ;; get unit signal/track stuff
  240. ;     (Clunits_Join_Units utt) ;; make a complete waveform
  241. ;     (apply_hooks cluster_synth_post_hooks utt)
  242. ;     utt)
  243. ; )
  244.  
  245.  
  246. (provide 'clunits)
  247.